home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / HFTUBE.ZIP / TUBE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-27  |  2.9 KB  |  107 lines
  1. Program Tube;
  2. {$M 4096,0,0}
  3. {$L Tube}
  4. Uses Crt;
  5. Var Err:Byte;
  6.     X,Y,N,OutputSeg,RadiusSeg,RadiusSegP,ColorSeg,ColorSegP,Rotate,
  7.      Moving,Width,Height:Word;
  8.     Line:Array[0..319] Of Byte;
  9.     Palette:Array[0..767] Of Byte;
  10.     Fil:File;
  11. Procedure VoxelTubeInit; External;
  12. Procedure VoxelTube; External;
  13. Procedure DrawVoxelTube; External;
  14. Procedure VoxelTubeFree; External;
  15. Begin
  16.  Asm Mov Ax,0003h; Int 10h; End;
  17.  Asm Mov   Err,01h
  18.      Call  VoxelTubeInit
  19.      Jc    @1
  20.      Mov   OutputSeg,Ax
  21.      Mov   Err,00h
  22.      Mov   Ah,48h            { Allocate memory for radius and color tables }
  23.      Mov   Bx,2000h
  24.      Int   21h
  25.      Mov   RadiusSeg,Ax
  26.      Jnc   @1
  27.      Mov   Err,01h
  28.      Call  VoxelTubeFree
  29.  @1:
  30.  End;
  31.  If Err>0 Then Begin WriteLn('Not enough memory!!!'); Halt(1); End;
  32.  ColorSeg:=RadiusSeg+$1000;
  33.  {$I-}
  34.  Assign(Fil,'TUBE.DAT'); Reset(Fil,1);
  35.  If IOResult<>0 Then Begin WriteLn('TUBE.DAT not found!'); Halt(1); End;
  36.  BlockRead(Fil,Mem[OutputSeg+$1000:0],64000); Close(Fil);
  37.  
  38.  For N:=0 to 65535 Do Mem[ColorSeg:N]:=62;
  39.  Assign(Fil,'TUBE.COL'); Reset(Fil,1);
  40.  If IOResult<>0 Then Begin WriteLn('TUBE.COL not found!'); Halt(1); End;
  41.  BlockRead(Fil,Palette,768); BlockRead(Fil,Width,2); BlockRead(Fil,Height,1);
  42.  For Y:=0 to Height-1 Do Begin
  43.   BlockRead(Fil,Line,Width);
  44.   For X:=0 to Width-1 Do Begin
  45.    Mem[ColorSeg:(Y+00)*512+X*2+0]:=Line[X];
  46.    Mem[ColorSeg:(Y+00)*512+X*2+1]:=Line[X]; End;
  47.   For X:=0 to Width-1 Do Begin
  48.    Mem[ColorSeg:(Y+64)*512+X*2+0]:=Line[X];
  49.    Mem[ColorSeg:(Y+64)*512+X*2+1]:=Line[X]; End; End; Close(Fil);
  50.  
  51.  WriteLn('Please wait, calculating tube radiuses...');
  52.  For Y:=0 to 127 Do For X:=0 to 511 Do Begin
  53.   Mem[RadiusSeg:Y*512+X]:=128+Round(80*(Sin(Y*Pi/8)*Sin(X*Pi/64))); End;
  54.  
  55.  Asm Mov Ax,0013h; Int 10h; End;
  56.  Port[$3C8]:=0; For N:=0 to 767 Do Port[$3C9]:=Palette[N];
  57.  
  58.  Rotate:=0;
  59.  Moving:=0;
  60.  Repeat
  61. { Asm Mov   Dx,03DAh
  62.  @1: In    Al,Dx
  63.      And   Al,08h
  64.      Jz    @1
  65.  @2: In    Al,Dx
  66.      And   Al,08h
  67.      Jnz   @2
  68.      Mov   Dx,03C0h
  69.      Mov   Al,31h
  70.      Out   Dx,Al
  71.      Out   Dx,Al
  72.  End;}
  73.   Asm Mov   Es,[OutputSeg]   { Clear output segment }
  74.       Mov   Di,65532
  75.   @1: Db    66h,33h,0C0h
  76.       Db    26h,66h,89h,05h
  77.       Sub   Di,04h
  78.       Jnc   @1
  79.   End;
  80.   ColorSegP:=ColorSeg+Moving;
  81.   RadiusSegP:=RadiusSeg+Moving;
  82.   Asm Push  Ds
  83.       Mov   Dx,Rotate        { Tube rotate value (0-511) }
  84.       Dw    02E8Eh,ColorSegP { Mov Gs,[ColorSeg] }
  85.       Mov   Ds,[RadiusSegP]
  86.       Call  VoxelTube
  87.       Pop   Ds
  88.   End;
  89.   Inc(Rotate,1); If Rotate>511 Then Dec(Rotate,512);
  90.   Inc(Moving,32); If Moving>2016 Then Dec(Moving,2048);
  91.   DrawVoxelTube;
  92. { Asm
  93.      Mov   Dx,03C0h
  94.      Mov   Al,31h
  95.      Out   Dx,Al
  96.      Xor   Al,Al
  97.      Out   Dx,Al
  98.  End;}
  99.  
  100. { For Y:=0 to 127 Do For X:=0 to 319 Do
  101.   Mem[$A000:Y*320+X]:=Mem[OutputSeg:Y*512+X];}
  102.  
  103.  Until KeyPressed;
  104.  Asm Mov Ax,0003h; Int 10h; End;
  105.  VoxelTubeFree;
  106. End.
  107.